Horizontal axis is for (monthly) average speed The vertical axis is for months Color by two colors: one for above overall average speed and the other for below the avarage speed The speed on the horizontal axis is standardized
library(ggplot2)
path <- "C:/Users/student/Documents/RStudio/c2015.xlsx"
library(readxl)
library(tidyverse)
## -- Attaching packages --------------------------------------- tidyverse 1.2.1 --
## v tibble 2.1.3 v purrr 0.3.2
## v tidyr 1.0.0 v dplyr 0.8.3
## v readr 1.3.1 v stringr 1.4.0
## v tibble 2.1.3 v forcats 0.4.0
## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()
library(dplyr)
library(stringr)
d=read_excel(path)
head(d)
## # A tibble: 6 x 28
## STATE ST_CASE VEH_NO PER_NO COUNTY DAY MONTH HOUR MINUTE AGE SEX
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <chr> <dbl> <dbl> <chr> <chr>
## 1 Alab~ 10001 1 1 127 1 Janu~ 2 40 68 Male
## 2 Alab~ 10002 1 1 83 1 Janu~ 22 13 49 Male
## 3 Alab~ 10003 1 1 11 1 Janu~ 1 25 31 Male
## 4 Alab~ 10003 1 2 11 1 Janu~ 1 25 20 Fema~
## 5 Alab~ 10004 1 1 45 4 Janu~ 0 57 40 Male
## 6 Alab~ 10005 1 1 45 7 Janu~ 7 9 24 Male
## # ... with 17 more variables: PER_TYP <chr>, INJ_SEV <chr>,
## # SEAT_POS <chr>, DRINKING <chr>, YEAR <dbl>, MAN_COLL <chr>,
## # OWNER <chr>, MOD_YEAR <chr>, TRAV_SP <chr>, DEFORMED <chr>,
## # DAY_WEEK <chr>, ROUTE <chr>, LATITUDE <dbl>, LONGITUD <dbl>,
## # HARM_EV <chr>, LGT_COND <chr>, WEATHER <chr>
#Remove NA, Unknown, Not Rep, Not Reported
d = d %>% filter_all(~!is.na(.))
d = d %>% filter_all(~!(.=="Unknown"))
d = d %>% filter_all(~!(.=="Not Rep"))
d = d %>% filter_all(~!(.==str_detect(.,"Not Rep")))
d = d %>% filter_all(~!(.==str_detect(.,"Unknown")))
d = d %>% filter_all(~!(.=="Not Reported"))
d = d %>% filter_all(~!(d$SEAT_POS == "Front Seat, Left Side"))
d$TRAV_SP[d$TRAV_SP=='Stopped'] <- '0'
d$TRAV_SP<- stringr::str_replace(d$TRAV_SP," MPH", "")
d$TRAV_SP <- as.numeric(d$TRAV_SP)
d<-d %>%
mutate(AGE=case_when(
AGE=='Less than 1' ~ '0',
TRUE ~ (AGE)))
d$AGE <- as.numeric(d$AGE)
d1<- d %>%
group_by(MONTH) %>%
summarize(speed_avg = mean(TRAV_SP, na.rm=TRUE))
d1$speed_z= round((d1$speed_avg - mean(d1$speed_avg))/sd(d1$speed_avg),2)
d1$speed_type = ifelse(d1$speed_z<0, "below","above")
ggplot(d1,aes(x=reorder(MONTH, speed_z), y=speed_z, label=speed_z)) +
geom_bar(stat='identity', aes(fill=speed_type), width=.5) + scale_fill_manual(name="Speed",
labels = c("Above Average", "Below Average"),
values= c("above"="#00ba38", "below"="#f8766d")) + labs(subtitle= "Normalized Average Speeds by Month",
title= "Diverging Bars") +
coord_flip()
library(gganimate)
library(gifski)
library(png)
d1<- d %>%
group_by(SEX,INJ_SEV,MONTH) %>%
summarize(speed_avg = mean(TRAV_SP, na.rm=TRUE))
d1$speed_z= round((d1$speed_avg - mean(d1$speed_avg))/sd(d1$speed_avg),2)
d1$speed_type = ifelse(d1$speed_z<0, "below","above")
ggplot(d1,aes(x=reorder(MONTH, speed_z), y=speed_z, label=speed_z)) +
geom_bar(stat='identity', aes(fill=speed_type), width=.5) + scale_fill_manual(name="Speed",
labels = c("Above Average", "Below Average"),
values= c("above"="#00ba38", "below"="#f8766d")) + labs(subtitle= "Normalized Average Speeds by Month",
title= "Diverging Bars") +
coord_flip() +
transition_states(MONTH) +
labs(title='MONTH = {closest_state}')
ggplot(d, aes(x= DRINKING, fill=SEX)) +
geom_bar() +
transition_states(MONTH) +
labs(title='MONTH = {closest_state}')
3. In this question, we work with the household debt and credit data. Do the follows to import the data to R
Download the data at this link. (Notice that if you use read_excel to read this file, you may not have the desired outcome.) Install the datapasta package so that we can copy and paste the data to R Open the downloaded file, tab Page 3 Data. Name the first column of the data table as Quarter Select and copy the data table including the variables In Rstudio: Tools -> Addins -> Browse Addins -> Select Paste as tribble -> Excute Don’t forget to name the
data<- tibble::tribble(
~Quarter, ~Mortgage, ~HE.Revolving, ~Auto.Loan, ~Credit.Card, ~Student.Loan, ~Other, ~Total,
"03:Q1", 4.94, 0.24, 0.64, 0.69, 0.24, 0.48, 7.23,
"03:Q2", 5.08, 0.26, 0.62, 0.69, 0.24, 0.49, 7.38,
"03:Q3", 5.18, 0.27, 0.68, 0.69, 0.25, 0.48, 7.56,
"03:Q4", 5.66, 0.3, 0.7, 0.7, 0.25, 0.45, 8.07,
"04:Q1", 5.84, 0.33, 0.72, 0.7, 0.26, 0.45, 8.29,
"04:Q2", 5.97, 0.37, 0.74, 0.7, 0.26, 0.42, 8.46,
"04:Q3", 6.21, 0.43, 0.75, 0.71, 0.33, 0.41, 8.83,
"04:Q4", 6.36, 0.47, 0.73, 0.72, 0.35, 0.42, 9.04,
"05:Q1", 6.51, 0.5, 0.73, 0.71, 0.36, 0.39, 9.21,
"05:Q2", 6.7, 0.53, 0.77, 0.72, 0.37, 0.4, 9.49,
"05:Q3", 6.91, 0.54, 0.83, 0.73, 0.38, 0.41, 9.79,
"05:Q4", 7.1, 0.57, 0.79, 0.74, 0.39, 0.42, 10,
"06:Q1", 7.44, 0.58, 0.79, 0.72, 0.43, 0.42, 10.38,
"06:Q2", 7.76, 0.59, 0.8, 0.74, 0.44, 0.42, 10.75,
"06:Q3", 8.05, 0.6, 0.82, 0.75, 0.45, 0.44, 11.11,
"06:Q4", 8.23, 0.6, 0.82, 0.77, 0.48, 0.41, 11.31,
"07:Q1", 8.42, 0.61, 0.79, 0.76, 0.51, 0.4, 11.5,
"07:Q2", 8.71, 0.62, 0.81, 0.8, 0.51, 0.41, 11.85,
"07:Q3", 8.93, 0.63, 0.82, 0.82, 0.53, 0.41, 12.13,
"07:Q4", 9.1, 0.65, 0.82, 0.84, 0.55, 0.42, 12.37,
"08:Q1", 9.23, 0.66, 0.81, 0.84, 0.58, 0.42, 12.54,
"08:Q2", 9.27, 0.68, 0.81, 0.85, 0.59, 0.4, 12.6,
"08:Q3", 9.29, 0.69, 0.81, 0.86, 0.61, 0.41, 12.68,
"08:Q4", 9.26, 0.71, 0.79, 0.87, 0.64, 0.41, 12.67,
"09:Q1", 9.14, 0.71, 0.77, 0.84, 0.66, 0.41, 12.53,
"09:Q2", 9.06, 0.71, 0.74, 0.82, 0.68, 0.39, 12.41,
"09:Q3", 8.94, 0.71, 0.74, 0.81, 0.69, 0.38, 12.28,
"09:Q4", 8.84, 0.71, 0.72, 0.8, 0.72, 0.38, 12.17,
"10:Q1", 8.83, 0.7, 0.7, 0.76, 0.76, 0.36, 12.12,
"10:Q2", 8.7, 0.68, 0.7, 0.74, 0.76, 0.35, 11.94,
"10:Q3", 8.61, 0.67, 0.71, 0.73, 0.78, 0.34, 11.84,
"10:Q4", 8.45, 0.67, 0.71, 0.73, 0.81, 0.34, 11.71,
"11:Q1", 8.54, 0.64, 0.71, 0.7, 0.84, 0.33, 11.75,
"11:Q2", 8.52, 0.62, 0.71, 0.69, 0.85, 0.33, 11.73,
"11:Q3", 8.4, 0.64, 0.73, 0.69, 0.87, 0.33, 11.66,
"11:Q4", 8.27, 0.63, 0.73, 0.7, 0.87, 0.33, 11.54,
"12:Q1", 8.19, 0.61, 0.74, 0.68, 0.9, 0.32, 11.44,
"12:Q2", 8.15, 0.59, 0.75, 0.67, 0.91, 0.31, 11.38,
"12:Q3", 8.03, 0.57, 0.77, 0.67, 0.96, 0.31, 11.31,
"12:Q4", 8.03, 0.56, 0.78, 0.68, 0.97, 0.32, 11.34,
"13:Q1", 7.93, 0.55, 0.79, 0.66, 0.99, 0.31, 11.23,
"13:Q2", 7.84, 0.54, 0.81, 0.67, 0.99, 0.3, 11.15,
"13:Q3", 7.9, 0.54, 0.85, 0.67, 1.03, 0.3, 11.28,
"13:Q4", 8.05, 0.53, 0.86, 0.68, 1.08, 0.32, 11.52,
"14:Q1", 8.17, 0.53, 0.88, 0.66, 1.11, 0.31, 11.65,
"14:Q2", 8.1, 0.52, 0.91, 0.67, 1.12, 0.32, 11.63,
"14:Q3", 8.13, 0.51, 0.93, 0.68, 1.13, 0.33, 11.71,
"14:Q4", 8.17, 0.51, 0.96, 0.7, 1.16, 0.34, 11.83,
"15:Q1", 8.17, 0.51, 0.97, 0.68, 1.19, 0.33, 11.85,
"15:Q2", 8.12, 0.5, 1.01, 0.7, 1.19, 0.34, 11.85,
"15:Q3", 8.26, 0.49, 1.05, 0.71, 1.2, 0.35, 12.07,
"15:Q4", 8.25, 0.49, 1.06, 0.73, 1.23, 0.35, 12.12,
"16:Q1", 8.37, 0.49, 1.07, 0.71, 1.26, 0.35, 12.25,
"16:Q2", 8.36, 0.48, 1.1, 0.73, 1.26, 0.36, 12.29,
"16:Q3", 8.35, 0.47, 1.14, 0.75, 1.28, 0.37, 12.35,
"16:Q4", 8.48, 0.47, 1.16, 0.78, 1.31, 0.38, 12.58,
"17:Q1", 8.63, 0.46, 1.17, 0.76, 1.34, 0.37, 12.73,
"17:Q2", 8.69, 0.45, 1.19, 0.78, 1.34, 0.38, 12.84,
"17:Q3", 8.74, 0.45, 1.21, 0.81, 1.36, 0.39, 12.96,
"17:Q4", 8.88, 0.44, 1.22, 0.83, 1.38, 0.39, 13.15,
"18:Q1", 8.94, 0.44, 1.23, 0.82, 1.41, 0.39, 13.21,
"18:Q2", 9, 0.43, 1.24, 0.83, 1.41, 0.39, 13.29,
"18:Q3", 9.14, 0.42, 1.27, 0.84, 1.44, 0.4, 13.51,
"18:Q4", 9.12, 0.41, 1.27, 0.87, 1.46, 0.41, 13.54,
"19:Q1", 9.24, 0.41, 1.28, 0.85, 1.49, 0.4, 13.67,
"19:Q2", 9.41, 0.4, 1.3, 0.87, 1.48, 0.41, 13.86
)
head(data)
## # A tibble: 6 x 8
## Quarter Mortgage HE.Revolving Auto.Loan Credit.Card Student.Loan Other
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 03:Q1 4.94 0.24 0.64 0.69 0.24 0.48
## 2 03:Q2 5.08 0.26 0.62 0.69 0.24 0.49
## 3 03:Q3 5.18 0.27 0.68 0.69 0.25 0.48
## 4 03:Q4 5.66 0.3 0.7 0.7 0.25 0.45
## 5 04:Q1 5.84 0.33 0.72 0.7 0.26 0.45
## 6 04:Q2 5.97 0.37 0.74 0.7 0.26 0.42
## # ... with 1 more variable: Total <dbl>
Plot a line plot between Student.Loan and Credit.Card
ggplot(data, aes(x=Student.Loan, y=Credit.Card))+
geom_line()
4.We want to add a moving variable in the graph of 3. The function transition_reveal (link) is great for this. You may tempt to add transition_reveal(Quarter) but notice that transition_reveal does not take the current form of Quarter. Hint: You can create a dummy variable running from 1 to the size of the data and make it the transition variable.
data$count <- 1 : nrow(data)
head(data$count)
## [1] 1 2 3 4 5 6
ggplot(data, aes(x=Student.Loan, y=Credit.Card))+
geom_line() +
transition_reveal(data$count)
5. The Quarter variable is not in the right format (date). Create the date column where the date is the first day of each quarter. Plot the graph of Student.Loan by date. Hint Use: the seq.date functions with the increment being three months.
data$date <- seq.Date(as.Date('2003-01-01'), as.Date('2019-06-01'), by = "3 months")
ggplot(data, aes(date, Student.Loan)) +
geom_line()
ggplot(data, aes(date, Student.Loan)) +
geom_line() +
transition_reveal(date)
7. Use geom_point and geom_text to plot the moving point and the value of the moving points. Hint: geom_point()+ geom_text(aes(label=Student.Loan)) should work.
ggplot(data, aes(date, Student.Loan)) +
geom_line() +
transition_reveal(date) +
geom_point() +
geom_text(aes(label=Student.Loan))
8. Include the graphs of other debts to the plot in Question 7, revealing them by date/quarter and differentiating them by colors. Hint: you may want to change the data from long to wide using the gather function.
data1 <- data %>%
gather(Value, key=Debt, c(Student.Loan, Mortgage, HE.Revolving, Auto.Loan, Credit.Card, Other))
ggplot(data1, aes(x=date, y=Value, color=Debt))+
geom_line()+
geom_point()+
geom_text(aes(label=Value))+
transition_reveal(date)
9. What is the debt that most correlated with the Total debt. Plot the graph of this debt and the total together revealing by years, differentiation by colors. Plot the remaining debt together in another plot, revealing by years, differentiating by colors. Give a comment on the plots. Label and put captions to the plots.
data1 <- data %>%
gather(Value, key=Debt, c(Student.Loan, Mortgage, HE.Revolving, Auto.Loan, Credit.Card, Other, Total))
ggplot(data1, aes(x=date, y=Value, color=Debt))+
geom_line()+
geom_point()+
geom_text(aes(label=Value))+
transition_reveal(date)
10.
data<- tibble::tribble(
~Quarter, ~Date, ~GDPGrowth,
"Q1_2000", "3/31/2000", 1.5,
"Q2_2000", "6/30/2000", 7.5,
"Q3_2000", "9/30/2000", 0.5,
"Q4_2000", "12/31/2000", 2.5,
"Q1_2001", "3/31/2001", -1.1,
"Q2_2001", "6/30/2001", 2.4,
"Q3_2001", "9/30/2001", -1.7,
"Q4_2001", "12/31/2001", 1.1,
"Q1_2002", "3/31/2002", 3.5,
"Q2_2002", "6/30/2002", 2.4,
"Q3_2002", "9/30/2002", 1.8,
"Q4_2002", "12/31/2002", 0.6,
"Q1_2003", "3/31/2003", 2.2,
"Q2_2003", "6/30/2003", 3.5,
"Q3_2003", "9/30/2003", 7,
"Q4_2003", "12/31/2003", 4.7,
"Q1_2004", "3/31/2004", 2.2,
"Q2_2004", "6/30/2004", 3.1,
"Q3_2004", "9/30/2004", 3.8,
"Q4_2004", "12/31/2004", 4.1,
"Q1_2005", "3/31/2005", 4.5,
"Q2_2005", "6/30/2005", 1.9,
"Q3_2005", "9/30/2005", 3.6,
"Q4_2005", "12/31/2005", 2.6,
"Q1_2006", "3/31/2006", 5.4,
"Q2_2006", "6/30/2006", 0.9,
"Q3_2006", "9/30/2006", 0.6,
"Q4_2006", "12/31/2006", 3.5,
"Q1_2007", "3/31/2007", 0.9,
"Q2_2007", "6/30/2007", 2.3,
"Q3_2007", "9/30/2007", 2.2,
"Q4_2007", "12/31/2007", 2.5,
"Q1_2008", "3/31/2008", -2.3,
"Q2_2008", "6/30/2008", 2.1,
"Q3_2008", "9/30/2008", -2.1,
"Q4_2008", "12/31/2008", -8.4,
"Q1_2009", "3/31/2009", -4.4,
"Q2_2009", "6/30/2009", -0.6,
"Q3_2009", "9/30/2009", 1.5,
"Q4_2009", "12/31/2009", 4.5,
"Q1_2010", "3/31/2010", 1.5,
"Q2_2010", "6/30/2010", 3.7,
"Q3_2010", "9/30/2010", 3,
"Q4_2010", "12/31/2010", 2,
"Q1_2011", "3/31/2011", -1,
"Q2_2011", "6/30/2011", 2.9,
"Q3_2011", "9/30/2011", -0.1,
"Q4_2011", "12/31/2011", 4.7,
"Q1_2012", "3/31/2012", 3.2,
"Q2_2012", "6/30/2012", 1.7,
"Q3_2012", "9/30/2012", 0.5,
"Q4_2012", "12/31/2012", 0.5,
"Q1_2013", "3/31/2013", 3.6,
"Q2_2013", "6/30/2013", 0.5,
"Q3_2013", "9/30/2013", 3.2,
"Q4_2013", "12/31/2013", 3.2,
"Q1_2014", "3/31/2014", -1.1,
"Q2_2014", "6/30/2014", 5.5,
"Q3_2014", "9/30/2014", 5,
"Q4_2014", "12/31/2014", 2.3,
"Q1_2015", "3/31/2015", 3.2,
"Q2_2015", "6/30/2015", 3,
"Q3_2015", "9/30/2015", 1.3,
"Q4_2015", "12/31/2015", 0.1,
"Q1_2016", "3/31/2016", 2,
"Q2_2016", "6/30/2016", 1.9,
"Q3_2016", "9/30/2016", 2.2,
"Q4_2016", "12/31/2016", 2,
"Q1_2017", "3/31/2017", 2.3,
"Q2_2017", "6/30/2017", 2.2,
"Q3_2017", "9/30/2017", 3.2,
"Q4_2017", "12/31/2017", 3.5,
"Q1_2018", "3/31/2018", 2.5,
"Q2_2018", "6/30/2018", 3.5,
"Q3_2018", "9/30/2018", 2.9,
"Q4_2018", "12/31/2018", 1.1,
"Q1_2019", "3/31/2019", 3.1,
"Q2_2019", "6/30/2019", 2.1
)
head(data)
## # A tibble: 6 x 3
## Quarter Date GDPGrowth
## <chr> <chr> <dbl>
## 1 Q1_2000 3/31/2000 1.5
## 2 Q2_2000 6/30/2000 7.5
## 3 Q3_2000 9/30/2000 0.5
## 4 Q4_2000 12/31/2000 2.5
## 5 Q1_2001 3/31/2001 -1.1
## 6 Q2_2001 6/30/2001 2.4
data$quardate <- seq.Date(as.Date('2000-03-30'), as.Date('2019-06-30'), by = "3 months")
ggplot(data, aes(quardate, GDPGrowth)) +
geom_line()+
transition_reveal(quardate)
data5 <- tibble::tribble(
~V1, ~ConsumerConfidence, ~ConsumerSentiment,
200001, 144.7, 112,
200002, 140.8, 111.3,
200003, 137.1, 107.1,
200004, 137.7, 109.2,
200005, 144.7, 110.7,
200006, 139.2, 106.4,
200007, 143, 108.3,
200008, 140.8, 107.3,
200009, 142.5, 106.8,
200010, 135.8, 105.8,
200011, 132.6, 107.6,
200012, 128.6, 98.4,
200101, 115.7, 94.7,
200102, 109.2, 90.6,
200103, 116.9, 91.5,
200104, 109.9, 88.4,
200105, 116.1, 92,
200106, 118.9, 92.6,
200107, 116.3, 92.4,
200108, 114, 91.5,
200109, 97, 81.8,
200110, 85.3, 82.7,
200111, 84.9, 83.9,
200112, 94.6, 88.8,
200201, 97.8, 93,
200202, 95, 90.7,
200203, 110.7, 95.7,
200204, 108.5, 93,
200205, 110.3, 96.9,
200206, 106.3, 92.4,
200207, 97.4, 88.1,
200208, 94.5, 87.6,
200209, 93.7, 86.1,
200210, 79.6, 80.6,
200211, 84.9, 84.2,
200212, 80.7, 86.7,
200301, 78.8, 82.4,
200302, 64.8, 79.9,
200303, 61.4, 77.6,
200304, 81, 86,
200305, 83.6, 92.1,
200306, 83.5, 89.7,
200307, 77, 90.9,
200308, 81.7, 89.3,
200309, 77, 87.7,
200310, 81.7, 89.6,
200311, 92.5, 93.7,
200312, 94.8, 92.6,
200401, 97.7, 103.8,
200402, 88.5, 94.4,
200403, 88.5, 95.8,
200404, 93, 94.2,
200405, 93.1, 90.2,
200406, 102.8, 95.6,
200407, 105.7, 96.7,
200408, 98.7, 95.9,
200409, 96.7, 94.2,
200410, 92.9, 91.7,
200411, 92.6, 92.8,
200412, 102.7, 97.1,
200501, 105.1, 95.5,
200502, 104.4, 94.1,
200503, 103, 92.6,
200504, 97.5, 87.7,
200505, 103.1, 86.9,
200506, 106.2, 96,
200507, 103.6, 96.5,
200508, 105.5, 89.1,
200509, 87.5, 76.9,
200510, 85.2, 74.2,
200511, 98.3, 81.6,
200512, 103.8, 91.5,
200601, 106.8, 91.2,
200602, 102.7, 86.7,
200603, 107.5, 88.9,
200604, 109.8, 87.4,
200605, 104.7, 79.1,
200606, 105.4, 84.9,
200607, 107, 84.7,
200608, 100.2, 82,
200609, 105.9, 85.4,
200610, 105.1, 93.6,
200611, 105.3, 92.1,
200612, 110, 91.7,
200701, 110.2, 96.9,
200702, 111.2, 91.3,
200703, 108.2, 88.4,
200704, 106.3, 87.1,
200705, 108.5, 88.3,
200706, 105.3, 85.3,
200707, 111.9, 90.4,
200708, 105.6, 83.4,
200709, 99.5, 83.4,
200710, 95.2, 80.9,
200711, 87.8, 76.1,
200712, 90.6, 75.5,
200801, 87.3, 78.4,
200802, 76.4, 70.8,
200803, 65.9, 69.5,
200804, 62.8, 62.6,
200805, 58.1, 59.8,
200806, 51, 56.4,
200807, 51.9, 61.2,
200808, 58.5, 63,
200809, 61.4, 70.3,
200810, 38.8, 57.6,
200811, 44.7, 55.3,
200812, 38.6, 60.1,
200901, 37.4, 61.2,
200902, 25.3, 56.3,
200903, 26.9, 57.3,
200904, 40.8, 65.1,
200905, 54.8, 68.7,
200906, 49.3, 70.8,
200907, 47.4, 66,
200908, 54.5, 65.7,
200909, 53.4, 73.5,
200910, 48.7, 70.6,
200911, 50.6, 67.4,
200912, 53.6, 72.5,
201001, 56.5, 74.4,
201002, 46.4, 73.6,
201003, 52.3, 73.6,
201004, 57.7, 72.2,
201005, 62.7, 73.6,
201006, 54.3, 76,
201007, 51, 67.8,
201008, 53.2, 68.9,
201009, 48.6, 68.2,
201010, 49.9, 67.7,
201011, 57.8, 71.6,
201012, 63.4, 74.5,
201101, 64.8, 74.2,
201102, 72, 77.5,
201103, 63.8, 67.5,
201104, 66, 69.8,
201105, 61.7, 74.3,
201106, 57.6, 71.5,
201107, 59.2, 63.7,
201108, 45.2, 55.8,
201109, 46.4, 59.5,
201110, 40.9, 60.8,
201111, 55.2, 63.7,
201112, 64.8, 69.9,
201201, 61.5, 75,
201202, 71.6, 75.3,
201203, 69.5, 76.2,
201204, 68.7, 76.4,
201205, 64.4, 79.3,
201206, 62.7, 73.2,
201207, 65.4, 72.3,
201208, 61.3, 74.3,
201209, 68.4, 78.3,
201210, 73.1, 82.6,
201211, 71.5, 82.7,
201212, 66.7, 72.9,
201301, 58.4, 73.8,
201302, 68, 77.6,
201303, 61.9, 78.6,
201304, 69, 76.4,
201305, 74.3, 84.5,
201306, 82.1, 84.1,
201307, 81, 85.1,
201308, 81.8, 82.1,
201309, 80.2, 77.5,
201310, 72.4, 73.2,
201311, 72, 75.1,
201312, 77.5, 82.5,
201401, 79.4, 81.2,
201402, 78.3, 81.6,
201403, 83.9, 80,
201404, 81.7, 84.1,
201405, 82.2, 81.9,
201406, 86.4, 82.5,
201407, 90.3, 81.8,
201408, 93.4, 82.5,
201409, 89, 84.6,
201410, 94.1, 86.9,
201411, 91, 88.8,
201412, 93.1, 93.6,
201501, 103.8, 98.1,
201502, 98.8, 95.4,
201503, 101.4, 93,
201504, 94.3, 95.9,
201505, 94.6, 90.7,
201506, 99.8, 96.1,
201507, 91, 93.1,
201508, 101.3, 91.9,
201509, 102.6, 87.2,
201510, 99.1, 90,
201511, 92.6, 91.3,
201512, 96.3, 92.6,
201601, 97.8, 92,
201602, 94, 91.7,
201603, 96.1, 91,
201604, 94.7, 89,
201605, 92.4, 94.7,
201606, 97.4, 93.5,
201607, 96.7, 90,
201608, 101.8, 89.8,
201609, 103.5, 91.2,
201610, 100.8, 87.2,
201611, 109.4, 93.8,
201612, 113.3, 98.2,
201701, 111.6, 98.5,
201702, 116.1, 96.3,
201703, 124.9, 96.9,
201704, 119.4, 97,
201705, 117.6, 97.1,
201706, 117.3, 95,
201707, 120, 93.4,
201708, 120.4, 96.8,
201709, 120.6, 95.1,
201710, 126.2, 100.7,
201711, 128.6, 98.5,
201712, 123.1, 95.9,
201801, 124.3, 95.7,
201802, 130, 99.7,
201803, 127, 101.4,
201804, 125.6, 98.8,
201805, 128.8, 98,
201806, 127.1, 98.2,
201807, 127.9, 97.9,
201808, 134.7, 96.2,
201809, 135.3, 100.1,
201810, 137.9, 98.6,
201811, 136.4, 97.5,
201812, 126.6, 98.3,
201901, 121.7, 91.2,
201902, 131.4, 93.8,
201903, 124.2, 98.4,
201904, 129.2, 97.2,
201905, 131.3, 100,
201906, 124.3, 98.2,
201907, 135.7, 98.4
)
avgConsumerConf <- sum(data5$ConsumerConfidence)/NROW(data5)
avgConsumerConf
## [1] 91.59447
avgConsumerSent <- sum(data5$ConsumerSentiment)/NROW(data5)
avgConsumerSent
## [1] 85.58766
ggplot(data5, aes(V1,y=ConsumerSentiment, color="Sentiment"))+
geom_line() +
geom_line(aes(x=V1,y=ConsumerConfidence, color="Confidence"))+
transition_reveal((V1))